home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
3337.ZIP
/
PCXSEE.ZIP
/
SHOWPCX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-23
|
29KB
|
877 lines
{$R-} {Range checking off}
{$B-} {Boolean complete evaluation off}
{$S-} {Stack checking off}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
UNIT ShowPCX;
{*************************************************************************}
{ }
{ This unit reads a PC Paintbrush PCX file and shows it on the screen. }
{ The picture may have 2,4 16 or 256 colors and be CGA, EGA, MCGA or VGA. }
{ The picture will be displayed until a key is pressed. }
{ }
{ This unit is based on a demo program (SHOW_PCX) downloaded from the BBS }
{ operated by Zsoft, the publisher of PC Paintbrush and the developer of }
{ the PCX picture format. }
{ }
{ Note: Many, many paint and draw programs can read and write PCX files. }
{ So, this unit is not restricted to just users of PC Paintbrush. }
{ }
{*************************************************************************}
INTERFACE
USES
OpCrt, Dos;
TYPE
str80 = String[80];
PROCEDURE ShowPicture(PicName : str80); {Only "Public" PROCEDURE}
IMPLEMENTATION
CONST
MAX_WIDTH = 4000; { arbitrary - maximum width (in bytes) of a PCX image }
COMPRESS_NUM = $C0; { this is the upper two bits that indicate a count }
MAX_BLOCK = 4096;
RED = 0;
GREEN = 1;
BLUE = 2;
{ The following display modes are supported:
"Type" Mode Graphics Card Resolution Colors
~~~~~~ ~~~~ ~~~~~~~~~~~~~ ~~~~~~~~~~ ~~~~~~ }
CGA04 = $04; { CGA 320 x 200 4 }
CGA06 = $06; { CGA 640 x 200 2 }
EGA0D = $0D; { EGA 320 x 200 16 }
EGA0E = $0E; { EGA 640 x 200 16 }
EGA10 = $10; { EGA 640 x 350 16 }
VGA12 = $12; { VGA 640 x 480 16 }
VGA13 = $13; { VGA 320 x 200 256 }
{ Mode $13 is supported only for files containing 256 color palette
information,
i.e. not those produced by versions of Paintbrush earlier than 3.0. }
TYPE
file_buffer = ARRAY[0..127] OF Byte;
block_array = ARRAY[0..MAX_BLOCK] OF Byte;
pal_array = ARRAY[0..255, RED..BLUE] OF Byte;
ega_array = ARRAY[0..16] OF Byte;
line_array = ARRAY[0..MAX_WIDTH] OF Byte;
EGAColorTriples = ARRAY[0..15, RED..BLUE] OF Byte;
{ RGB palette data (16 colors or less)
256 color palette is appended to end of file }
pcx_header = RECORD
Manufacturer : Byte; { Always 10 for PCX file }
Version : Byte; { 0 - old PCX - Version 2.5 (not used anymore),
2 - Version 2.8 - With palette info,
3 - Version 2.8 - Without palette info,
4 - Microsoft Windows - no palette (only in
old files, new Windows uses Version 3.0),
5 - Version 3.0 with palette }
Encoding : Byte; { 1 is PCX, it is possible that we may add
additional encoding methods in the future }
Bits_per_pixel : Byte; { Number of bits to represent a pixel
(per plane) - 1, 2, 4, or 8 }
Xmin : Integer; { Image window dimensions (inclusive) }
Ymin : Integer; { Xmin, Ymin are usually zero (not always) }
Xmax : Integer;
Ymax : Integer;
Hdpi : Integer; { Resolution of image (dots per inch) }
Vdpi : Integer; { Set to scanner resolution - 300 is default }
ColorMap : EGAColorTriples;
{ RGB palette data (16 colors or less)
256 color palette is appended to end of file }
Reserved : Byte; { (used to contain video mode)
now it is ignored - just set to zero }
Nplanes : Byte; { Number of planes }
Bytes_per_line_per_plane : Integer; { Number of bytes to allocate
for a scanline plane.
MUST be an an EVEN number!
Do NOT calculate from Xmax-Xmin! }
PaletteInfo : Integer; { 1 = black & white or color image,
2 = grayscale image - ignored in PB4, PB4+
palette must also be set to shades of gray! }
HscreenSize : Integer; { added for PC Paintbrush IV Plus ver 1.0, }
VscreenSize : Integer; { PC Paintbrush IV ver 1.02 (and later) }
{ I know it is tempting to use these fields
to determine what video mode should be used
to display the image - but it is NOT
recommended since the fields will probably
just contain garbage. It is better to have
the user install for the graphics mode he
wants to use... }
Filler : ARRAY[74..127] OF Byte; { Just set to zeros }
END;
VAR
Name : str80; { Name of PCX file to load }
ImageName : str80; { Name of PCX file - used by ReadError }
BlockFile : FILE; { file for reading block data }
BlockData : block_array; { 4k data buffer }
Header : pcx_header; { PCX file header }
Palette256 : pal_array; { place to put 256 color palette }
PaletteEGA : ega_array; { place to put 16 EGA palette values }
PCXline : line_array; { place to put uncompressed data }
Ymax : Integer; { maximum Y value on screen }
NextByte : Integer; { index into file buffer in ReadByte }
Index : Integer; { PCXline index - where to put Data }
Data : Byte; { PCX compressed data byte }
PictureMode : Integer; { Graphics mode number }
Reg : Registers; { Register set - used for int 10 calls }
Colors : Integer; { Number of Colors in picture}
Xoffset : Integer; { Offset used to "center" picture }
Center : Boolean; { Flag used to decide on "centering" }
Xsize, Ysize : Integer; { Size of "default" screen for picture }
PicXsize, PicYsize : Integer; { Size of picture }
UseDefaultPalette : Boolean;
CONST
EGATriplet : EGAColorTriples = ( { 48byte default EGA/VGA palette}
($00, $00, $00), { black }
($00, $00, $AA), { blue }
($00, $AA, $00), { green }
($00, $AA, $AA), { cyan }
($AA, $00, $00), { red }
($AA, $00, $AA), { magenta }
($AA, $55, $00), { brown }
($AA, $AA, $AA), { lightgray }
($55, $55, $55), { darkgray }
($00, $00, $FF), { lightblue }
($00, $FF, $00), { lightgreen }
($00, $FF, $FF), { lightcyan }
($FF, $00, $00), { lightred }
($FF, $00, $FF), { lightmagenta }
($FF, $FF, $00), { yellow }
($FF, $FF, $FF)); { white }
{ ================================= Error ================================== }
PROCEDURE Error(s : str80);
{ Print out the error message and wait, then halt }
VAR c : Char;
i : Integer;
BEGIN
TextMode(C80);
WriteLn('ERROR');
WriteLn(s);
Halt;
END; { Error }
{ =============================== ReadError =============================== }
PROCEDURE ReadError(msg : Integer);
{ Check for an i/o error }
BEGIN
IF IoResult <> 0 THEN
CASE msg OF
1 : Error('Can''t open file - '+ImageName);
2 : Error('Error closing file - '+ImageName+' - disk may be full');
3 : Error('Error reading file - '+ImageName);
ELSE
Error('Error doing file I/O - '+ImageName);
END; { case }
END; { ReadError }
{ =========================== VideoMode =============================== }
PROCEDURE VideoMode(n : Integer);
{ Do a BIOS call to set the video mode }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
BEGIN
Reg.ah := $00;
Reg.al := n; { mode number }
intr($10, Reg); { call interrupt }
END; { VideoMode }
{ =========================== CGApalette =============================== }
PROCEDURE CGApalette;
{ Set the CGA 4 color palette. }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
BackGround, ForeGround, Palette : Byte;
Intense : Boolean;
BEGIN
BackGround := Header.ColorMap[0, RED]SHR 4;
{ Top four bits of first BYTE of Color map represent Background color }
ForeGround := Header.ColorMap[1, RED]SHR 5;
{ Top three bits of fourth BYTE of Color map defines Foreground colors }
{ Where Bit = 0 -- is Intensity (0 = Dim, 1 = Bright) }
{ Where Bit = 1 -- is Palette (0 = Red-Green-Brown,
1 = Cyan-Magenta-White) }
{ Where Bit = 2 -- is "BurstEnable" (0 = Color, 1 = Mono) }
Palette := ForeGround AND 2;
IF (ForeGround AND 1) = 1
THEN Intense := True
ELSE Intense := False;
IF Intense THEN
BEGIN
IF Palette = 1
THEN Palette := 3 {Light Cyan - Light Magenta - White}
ELSE Palette := 1; {Cyan - Magenta - White}
END
ELSE BEGIN
IF Palette = 0
THEN Palette := 2 {Light Green - Light Red - Yellow}
ELSE Palette := 0; {Green - Red - Brown}
END;
{ First -- Set CGA Palette }
Reg.ah := $0B; { Set CGA Palette }
Reg.bh := $01; { set palette }
Reg.bl := Palette; { set palette }
intr($10, Reg); { call interrupt }
{ Now -- Set Background Color }
Reg.ah := $0B; { Set CGA Palette }
Reg.bh := $00; { set Background }
Reg.bl := BackGround; { set BackGround color }
intr($10, Reg); { call interrupt }
END; { CGApalette }
{ =========================== EGA16palette =============================== }
PROCEDURE EGA16palette;
{ Set the EGA's entire 16 color palette. }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
i, r, g, b : Integer;
BEGIN
FOR i := 0 TO 15 DO
BEGIN
r := Header.ColorMap[i, RED]SHR 6; { r, g, and b are now 0..3 }
g := Header.ColorMap[i, GREEN]SHR 6;
b := Header.ColorMap[i, BLUE]SHR 6;
PaletteEGA[i] := (r SHL 4)+(g SHL 2)+b;
END;
PaletteEGA[16] := 0; { border color }
Reg.ah := $10; { Set Palette Call }
Reg.al := $02; { set a block of palette registers }
Reg.dx := Ofs(PaletteEGA); { offset of block }
Reg.es := Seg(PaletteEGA); { segment of block }
intr($10, Reg); { call interrupt }
END; { EGA16palette }
{ =========================== VGA16palette =============================== }
PROCEDURE VGA16palette;
{ Set the VGA's entire 16 color palette. }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
i : Integer;
BEGIN
FOR i := 0 TO 15 DO
PaletteEGA[i] := i;
PaletteEGA[16] := 0; { border color }
Reg.ah := $10; { Set Palette Call }
Reg.al := $02; { set a block of palette registers }
Reg.dx := Ofs(PaletteEGA); { offset of block }
Reg.es := Seg(PaletteEGA); { segment of block }
intr($10, Reg); { call interrupt }
FOR i := 0 TO 15 DO
BEGIN { R, G, and B must be 0..63 }
Palette256[i, RED] := Header.ColorMap[i, RED]SHR 2;
Palette256[i, GREEN] := Header.ColorMap[i, GREEN]SHR 2;
Palette256[i, BLUE] := Header.ColorMap[i, BLUE]SHR 2;
END;
Reg.ah := $10; { Set DAC Call }
Reg.al := $12; { set a block of DAC registers }
Reg.bx := 0; { first DAC register number }
Reg.cx := 255; { number of registers to update }
Reg.dx := Ofs(Palette256); { offset of block }
Reg.es := Seg(Palette256); { segment of block }
intr($10, Reg); { call interrupt }
END; { VGA16palette }
{ ===================== SetDefaultPalette =============================== }
PROCEDURE SetDefaultPalette;
{ Set the CGA/EGA/VGA 4 or 16 color palette to the "default" values. }
BEGIN
Header.ColorMap := EGATriplet; { 48 byte default EGA/VGA palette }
IF CurrentDisplay = EGA THEN EGA16palette;
IF CurrentDisplay = VGA THEN VGA16palette;
IF (CurrentDisplay = CGA) AND(PictureMode = CGA04) THEN
BEGIN
{ First -- Set CGA Palette }
Reg.ah := $0B; { Set CGA Palette }
Reg.bh := $01; { set palette }
Reg.bl := 1; { set palette to Cyan - Magenta - White}
intr($10, Reg); { call interrupt }
{ Now -- Set Background Color }
Reg.ah := $0B; { Set CGA Palette }
Reg.bh := $00; { set Background }
Reg.bl := 0; { set BackGround color to Black}
intr($10, Reg); { call interrupt }
END;
END; { SetDefaultPalette }
{ =========================== EntireVGApalette =============================== }
PROCEDURE EntireVGApalette;
{ Set the VGA's entire 256 color palette. }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
i : Integer;
BEGIN
FOR i := 0 TO 255 DO
BEGIN { R, G, and B must be 0..63 }
Palette256[i, RED] := Palette256[i, RED]SHR 2;
Palette256[i, GREEN] := Palette256[i, GREEN]SHR 2;
Palette256[i, BLUE] := Palette256[i, BLUE]SHR 2;
END;
Reg.ah := $10; { Set DAC Call }
Reg.al := $12; { set a block of DAC registers }
Reg.bx := 0; { first DAC register number }
Reg.cx := 255; { number of registers to update }
Reg.dx := Ofs(Palette256); { offset of block }
Reg.es := Seg(Palette256); { segment of block }
intr($10, Reg); { call interrupt }
END; { EntireVGApalette }
{ =========================== SetPalette =============================== }
PROCEDURE SetPalette;
{ Set up the entire graphics palette }
VAR i : Integer;
BEGIN
{Don't set or reset palette for $0E and $0F modes}
{This is an "undocumented quirk" of the .PCX standard}
IF NOT (PictureMode IN[EGA0D, EGA0E]) THEN
{Use Default palette if last character of picture file name is underscore}
IF UseDefaultPalette
THEN SetDefaultPalette
ELSE BEGIN {Set Special Palette}
IF PictureMode = VGA13 THEN
IF (CurrentDisplay IN[VGA, PGC, MCGA])
THEN EntireVGApalette
ELSE Error('Mode not supported');
IF (PictureMode = VGA12) THEN
IF (CurrentDisplay IN[EGA, VGA, PGC, MCGA])
THEN VGA16palette
ELSE Error('Mode not supported');
IF (PictureMode = EGA10) THEN
IF (CurrentDisplay IN[VGA, PGC, MCGA])
THEN VGA16palette
ELSE IF (CurrentDisplay = EGA)
THEN EGA16palette
ELSE Error('Mode not supported');
IF PictureMode IN[CGA04, CGA06] THEN
IF (CurrentDisplay = MonoHerc)
THEN Error('Mode not supported')
ELSE IF PictureMode = CGA04
THEN CGApalette;
END; {Set Special Palette}
END; { SetPalette }
{ =========================== ShowCGA =============================== }
PROCEDURE ShowCGA(Y : Integer);
{ Put a line of CGA data on the screen }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
i, j, l, m, t : Integer;
Yoffset : Integer;
CGAScreen : ARRAY[0..32000] OF Byte ABSOLUTE $B800 : $0000;
BEGIN
i := 8 DIV Header.Bits_per_pixel; { i is pixels per byte }
IF (i = 8) THEN { 1 bit per pixel }
j := 7
ELSE { 2 bits per pixel }
j := 3;
t := (Header.Xmax-Header.Xmin+1); { width in pixels }
m := t AND j; { left over bits }
l := (t+j) DIV i; { compute number of bytes to display }
IF l > 80 THEN
BEGIN
l := 80; { don't overrun screen width }
m := 0;
END;
IF (m <> 0) THEN { we need to mask unseen pixels }
BEGIN
m := $FF SHL(8-(m*Header.Bits_per_pixel)); { m = mask }
t := l-1;
PCXline[t] := PCXline[t]AND m; { mask off unseen pixels }
END;
Xoffset := 0;
IF Center THEN Xoffset := (80-l) DIV 2; { Offset to "center" picture }
Yoffset := 8192*(Y AND 1);
Move(PCXline[0], CGAScreen[((Y SHR 1)*80)+Yoffset+Xoffset], l);
END; { ShowCGA }
{ =========================== ShowEGA =============================== }
PROCEDURE ShowEGA(Y : Integer);
{ Put a line of EGA (or VGA) data on the screen }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
i, j, l, m, t : Integer;
EGAplane : Integer;
EGAscreen : ARRAY[0..32000] OF Byte ABSOLUTE $A000 : $0000;
BEGIN
EGAplane := $0100; { the first plane to update }
PortW[$3CE] := $0005; { use write mode 0 }
{ PortW [$3CE] := $0005; does port I/O by words. It is the same as:
Out 03CEh,05h
Out 03CFh,00h
}
t := (Header.Xmax-Header.Xmin+1); { width in pixels }
m := t AND 7; { left over bits }
l := (t+7) SHR 3; { compute number of bytes to display }
IF (l >= 80) THEN
BEGIN
l := 80; { don't overrun screen width }
m := 0;
END;
IF (m <> 0) THEN
m := $FF SHL(8-m) { m = mask for unseen pixels }
ELSE
m := $FF;
Xoffset := 0;
IF Center THEN Xoffset := (80-l) DIV 2; { Offset to "center" picture }
FOR i := 0 TO Header.Nplanes-1 DO
BEGIN
j := i*Header.Bytes_per_line_per_plane;
t := j+l-1;
PCXline[t] := PCXline[t]AND m; { mask off unseen pixels }
PortW[$3C4] := EGAplane+2; { set plane number }
Move(PCXline[j], EGAscreen[Y*80+Xoffset], l);
EGAplane := EGAplane SHL 1;
END;
PortW[$3C4] := $0F02; { default plane mask }
END; { ShowEGA }
{ =========================== ShowMCGA =============================== }
PROCEDURE ShowMCGA(Y : Integer);
{ Put a line of MCGA data on the screen }
{ In Turbo Pascal, a '$' means the number is hexadeximal. }
VAR
l : Integer;
MCGAscreen : ARRAY[0..64000] OF Byte ABSOLUTE $A000 : $0000;
BEGIN
l := Header.Xmax-Header.Xmin; { compute number of bytes to display }
IF l > 320 THEN
l := 320; { don't overrun screen width }
Xoffset := 0;
IF Center THEN Xoffset := (320-l) DIV 2; { Offset to "center" picture }
Move(PCXline[0], MCGAscreen[Y*320+Xoffset], l);
END; { ShowMCGA }
{ =========================== Read256palette =============================== }
PROCEDURE Read256palette;
{ Read in a 256 color palette at end of PCX file }
VAR
i : Integer;
b : Byte;
BEGIN
Seek(BlockFile, FileSize(BlockFile)-769);
BlockRead(BlockFile, b, 1); { read indicator byte }
ReadError(3);
IF b <> 12 THEN { no palette here... }
Exit;
BlockRead(BlockFile, Palette256, 3*256);
ReadError(3);
Seek(BlockFile, 128); { go back to start of PCX data }
END; { Read256palette }
{ =========================== ReadHeader =============================== }
PROCEDURE ReadHeader;
{ Load a picture header from a PC Paintbrush PCX file }
VAR
Yoffset : Integer;
LABEL WrongFormat;
BEGIN
{$I-}
BlockRead(BlockFile, Header, 128); { read 128 byte PCX header }
ReadError(3);
Colors := 0; { To begin with }
{ Is it a PCX file? }
IF (Header.Manufacturer <> 10) OR(Header.Encoding <> 1) THEN
BEGIN
Close(BlockFile);
Error('This is not a valid PCX image file.');
END;
PicYsize := Header.Ymax-Header.Ymin+1;
PicXsize := Header.Xmax-Header.Xmin+1;
IF (Header.Nplanes = 4) AND(Header.Bits_per_pixel = 1) THEN
BEGIN
Colors := 16; { For both EGA and VGA }
Xsize := 640; { X size of "default" screen }
IF (Header.Ymax-Header.Ymin) <= 199 THEN
BEGIN
PictureMode := EGA0E;
Ymax := 199;
Ysize := 200; { Y size of "default" screen }
END
ELSE
IF (Header.Ymax-Header.Ymin) <= 349 THEN
BEGIN
PictureMode := EGA10;
Ymax := 349;
Ysize := 350; { Y size of "default" screen }
END
ELSE
BEGIN
PictureMode := VGA12;
Ymax := 479;
Ysize := 480; { Y size of "default" screen }
END;
END
ELSE IF (Header.Nplanes = 1) THEN
BEGIN
Ymax := 199;
Ysize := 200; { Y size of "default" screen }
IF (Header.Bits_per_pixel = 1) THEN
{2 Colors}
BEGIN
Colors := 2; { 2-colors }
Xsize := 640; { X size of "default" screen }
PictureMode := CGA06;
END
{4 Colors}
ELSE IF (Header.Bits_per_pixel = 2) THEN
BEGIN
PictureMode := CGA04;
Colors := 4; { CGA 4-colors }
Xsize := 320; { X size of "default" screen }
END
ELSE IF (Header.Bits_per_pixel = 8) THEN
BEGIN
PictureMode := VGA13;
Colors := 256; { MCGA 256-colors }
Xsize := 320; { X size of "default" screen }
IF Header.Version = 5 THEN
Read256palette;
END
ELSE
GOTO WrongFormat;
END
ELSE
BEGIN
WrongFormat:
Close(BlockFile);
Error('PCX file is in wrong format - It must be a CGA, EGA, VGA, or MCGA image');
END;
Index := 0;
NextByte := MAX_BLOCK; { indicates no data read in yet... }
Yoffset := 0;
IF Center THEN Yoffset := (Ymax+1-PicYsize) DIV 2;
Header.Ymax := Header.Ymax+Yoffset;
Header.Ymin := Header.Ymin+Yoffset;
END; { ReadHeader }
{ =========================== ReadByte =============================== }
PROCEDURE ReadByte;
{ read a single byte of data - use BlockRead because it is FAST! }
VAR
NumBlocksRead : Integer;
BEGIN
IF NextByte = MAX_BLOCK THEN
BEGIN
BlockRead(BlockFile, BlockData, MAX_BLOCK, NumBlocksRead);
NextByte := 0;
END;
Data := BlockData[NextByte];
Inc(NextByte); { NextByte++; }
END; { ReadByte }
{ =========================== Read_PCX_Line =============================== }
PROCEDURE Read_PCX_Line;
{ Read a line from a PC Paintbrush PCX file }
VAR
count : Integer;
bytes_per_line : Integer;
BEGIN
{$I-}
bytes_per_line := Header.Bytes_per_line_per_plane*Header.Nplanes;
{ bring in any data that wrapped from previous line }
{ usually none - this is just to be safe }
IF Index <> 0 THEN
FillChar(PCXline[0], Index, Data); { fills a contiguous block of data }
WHILE (Index < bytes_per_line) DO { read 1 line of data (all planes) }
BEGIN
ReadByte;
IF (Data AND $C0) = COMPRESS_NUM THEN
BEGIN
count := Data AND $3F;
ReadByte;
FillChar(PCXline[Index], count, Data); { fills a contiguous block }
Inc(Index, count); { Index += count; }
END
ELSE
BEGIN
PCXline[Index] := Data;
Inc(Index); { Index++; }
END;
END;
ReadError(3);
Index := Index-bytes_per_line;
{$I+}
END; { Read_PCX_Line }
{ =========================== Read_PCX =============================== }
PROCEDURE Read_PCX(Name : str80);
{ Read PC Paintbrush PCX file and put it on the screen }
VAR
k, kmax : Integer;
BEGIN
{$I-}
ImageName := Name; { used by ReadError }
Assign(BlockFile, Name);
Reset(BlockFile, 1); { use 1 byte blocks }
ReadError(1);
ReadHeader; { read the PCX header }
VideoMode(PictureMode); { switch to graphics mode }
IF Header.Version <> 3 THEN
SetPalette; { set the screen palette, if available }
kmax := Header.Ymin+Ymax;
IF Header.Ymax < kmax THEN { don't show more than the screen can display }
kmax := Header.Ymax;
IF (PictureMode IN[EGA0D, EGA0E, EGA10, VGA12]) THEN
BEGIN { 16 Colors }
FOR k := Header.Ymin TO kmax DO { each loop is separate for speed }
BEGIN
Read_PCX_Line;
ShowEGA(k);
END;
END
ELSE IF (PictureMode = VGA13) THEN
BEGIN { 256 Colors }
FOR k := Header.Ymin TO kmax DO
BEGIN
Read_PCX_Line;
ShowMCGA(k);
END;
END
ELSE { 2 or 4 Colors -- probably a CGA picture }
BEGIN
FOR k := Header.Ymin TO kmax DO
BEGIN
Read_PCX_Line;
ShowCGA(k);
END;
END;
Close(BlockFile);
ReadError(2);
{$I+}
END; { Read_PCX }
{ =========================== DISPLAY_PCX =============================== }
PROCEDURE display_pcx(Name : str80);
{ Display a PCX picture }
VAR
c : Char;
BEGIN
Read_PCX(Name); { read and display the file }
WHILE (NOT KeyPressed) DO { wait for any key to be pressed }
{ nothing } ;
c := ReadKey; { now get rid of the key that was pressed }
IF c = #0 THEN { handle function keys }
c := ReadKey;
END; { display_pcx }
PROCEDURE ShowPicture(PicName : str80);
VAR Spot : Integer;
BEGIN
Center := True; { "Center" pictures }
ClrScr;
UseDefaultPalette := False;
Spot := Pos('.', PicName);
IF PicName[Spot-1] = '_' THEN
UseDefaultPalette := True;
{Use Default palette if last character of picture file name is underscore}
Name := PicName;
IF CurrentDisplay = MonoHerc
THEN Error('PCX file is in wrong format - It must be a CGA, EGA, VGA, or MCGA image')
ELSE BEGIN {Valid graphics display}
display_pcx(Name);
TextMode(co80); { back to text mode }
END;
END; { ShowPicture }
BEGIN
{Empty Initialization}
END. {Unit}